CU Amiga Super CD-ROM 19/CU Amiga Magazine's Super CD-ROM 19 (1998)(EMAP Images)(GB)[!][issue 1998-02].iso/CUCD/Utilities/Scion/ARexx/translate.rexx

OS/2 REXX Batch file | 1997-11-04 | 16KB | 484 lines

/****************************************************************************
 *                                                                          *
 * $VER: Translate 1.37 (12 Oct 1997)
 *                                                                          *
 *                      Written by Freddy Ariës                             *
 * Address: Lindeboomweg 7, NL-7135 KE Harreveld, The Netherlands.          *
 *                                                                          *
 * You may have noticed that setting another language in Locale means that  *
 * the date (month) fields of your database are no longer recognized        *
 * correctly. This is where Translate comes in.                             *
 * It will convert all the standard language fields in a Scion database (in *
 * v4.0+, that means the Date fields) into another (predefined) language.   *
 * Currently Dutch, German, French, Italian, Norwegian, Swedish and Finnish *
 * are supported, but only translation to and from English is possible.     *
 * Adding other languages shouldn't be too hard.                            *
 *                                                                          *
 * This script uses (by default) the rexxreqtools.library (which requires   *
 * a version of reqtools larger than 2.0 and rexxsyslib.library)            *
 * If you do not have these, run SetDefaults.rexx to change the settings.   *
 *                                                                          *
 * TO DO:                                                                   *
 * - add Locale support (current language <-> English)                      *
 *                                                                          *
 * DONE:                                                                    *
 * - progress indicator, using rexxarplib.library                           *
 *   (requested by Robbie Akins himself)                                    *
 * - now uses preference file for default settings                          *
 * - Scion v5 recognition added. Due to the nature of dates in Scion V5,    *
 *   this script doesn't work anymore for Scion version 5 and up. Scion     *
 *   will always recognize the correct date, and display it in the          *
 *   currently selected user-language.                                      *
 *                                                                          *
 ****************************************************************************/

options failat 20; options results
arg panum outval

versionstr = "1.37"

/* Don't change the settings here! Run SetDefaults.rexx instead! */
usereq = 1; outp = 1; prgrs = 1; pgopen = 0
PSCR = "SCIONGEN"

scrdev = stdout
scrname = "CON:0//639//Scion Output/AUTO/SCREEN"
NL = '0A'x

/* parse command line options, to allow calling the script automatically,
 * eg. from a function key
 */

do while panum = '?'
  Tell("NUMOPT/N,QUIET/S,NOREQ/s: ")
  pull panum outval
end

/* read preferences file. */

if open(pfile, 'ENV:Scion/ScionRexx.prefs', 'r') then do
  do while ~eof(pfile)
    inln = readln(pfile)
    if inln ~= "" then do
      wstr = upper(word(inln, 1))
      if wstr = "USEREQ" then
        usereq = 1
      else if wstr = "NOUSEREQ" then
        usereq = 0
      else if wstr = "PROGRESS" then
        prgrs = 1
      else if wstr = "NOPROGRESS" then
        prgrs = 0
      else if wstr = "PUBSCREEN" then
        pscr = strip(delstr(inln, 1, length(wstr)), 'b', ' "')
    end
  end
  close(pfile)
end

if pscr = "" | (pscr ~= "WORKBENCH" & ~show('p', pscr)) then
  pscr = "SCIONGEN"
wstr = right(notesdir, 1)
if wstr ~= '/' & wstr ~= ':' then notesdir = ""
scrname = scrname||pscr

if panum ~= "" then do
  if panum = "QUIET" then do
    panum = ""; outval = "QUIET"
    lang = 0
  end
  else if panum = "NOREQ" then do
    panum = ""; outval = "NOREQ"
    lang = 0
  end
  else do
    pnum = C2D(upper(left(panum,1)))
    if pnum >= 65 & pnum <= 92 then do
      panum = pnum - 64
      lang = CheckAnswer(panum)
    end
    else if pnum > 47 & pnum < 58 then
      lang = CheckAnswer(panum)
    else do
      lang = 0; panum = ""
    end
  end
end
else
  lang = 0

if outval = "QUIET" then do
  outp = 0; usereq = 0; prgrs  0
end
else if outval = "NOREQ" then do
  usereq = 0; prgrs = 0
end

if usereq & ~show('l','rexxreqtools.library') then do
  if exists('libs:rexxreqtools.library') then
    call addlib('rexxreqtools.library',0,-30,0)
  else do
    usereq = 0; outp = 1
    Tell("Unable to open rexxreqtools.library - using text output")
  end
end

if ~usereq then prgrs = 0

if prgrs & ~show('l','rexxarplib.library') then do
  if exists('libs:rexxarplib.library') then
    call addlib('rexxarplib.library',0,-30,0)
  else
    prgrs = 0
end

screentofront(pscr)

if ~show('P','SCIONGEN') then do
  EndString('I am sorry to say that the SCION Genealogist' || NL ||,
    'database is not available. Please start the' || NL ||,
    'SCION program BEFORE using this script!')
end

myport = "SCIONGEN"
address value myport
GETDBNAME
dbname = upper(RESULT)
GETPROGVERSION
progvers = RESULT

if outp & ~usereq then do
  if pscr ~= "WORKBENCH" then do
    scrdev = 'SCNDSCSCR'
    if ~open(scrdev, scrname, 'w') then scrdev = stdout
  end
  Tell("Translate - Scion Language Fields Converter "||versionstr||" by Freddy Ariës")
  Tell("Database: "||dbname|| NL)
end

if progvers >= 5 then do
  EndString("********************************************"|| NL ||,
    "***     SCION VERSION "||progvers||" DETECTED.     ***"|| NL ||,
    "*** THIS SCRIPT IS NO LONGER REQUIRED!!! ***"|| NL ||,
    "********************************************")
end

if lang = 0 then do
  if ~outp then
    EndString("Missing required argument!")
    /* even though you will never get to see the message... */
  if usereq then do
    answ = rtezrequest('Database: '||dbname || NL ||,
      'Please select one of the following conversions: ' || NL || NL ||,
      ' a) Nederlands -> English      i) Norsk    -> English' || NL ||,
      ' b) English    -> Nederlands   j) English  -> Norsk' || NL ||,
      ' c) Deutsch    -> English      k) Svenska  -> English' || NL ||,
      ' d) English    -> Deutsch      l) English  -> Svenska' || NL ||,
      ' e) Français   -> English      m) Suomi    -> English' || NL ||,
      ' f) English    -> Français     n) English  -> Suomi' || NL ||,
      ' g) Italiano   -> English      o) current language -> English' || NL ||,
      ' h) English    -> Italiano     p) English -> current language' || NL ||,
      ' 0) Abort' ||,
      NL, '_a|_b|_c|_d|_e|_f|_g|_h|_i|_j|_k|_l|_m|_n|_o|_p|_0','Translate - Scion Language Field Converter '|| versionstr || ' by Freddy Ariës','rtez_flags=ezreqf_noreturnkey rt_pubscrname='||PSCR)
  end
  else if outp then do
    Tell("Please select one of the following conversions: ")
    Tell(" a) Nederlands -> English      i) Norsk    -> English")
    Tell(" b) English    -> Nederlands   j) English  -> Norsk")
    Tell(" c) Deutsch    -> English      k) Svenska  -> English")
    Tell(" d) English    -> Deutsch      l) English  -> Svenska")
    Tell(" e) Français   -> English      m) Suomo    -> English")
    Tell(" f) English    -> Français     n) English  -> Suomi")
    Tell(" g) Italiano   -> English      o) current language -> English")
    Tell(" h) English    -> Italiano     p) English -> current language")
    Tell(" 0) Abort")
    TellNN("Your choice: ")
    answ = readln(scrdev)
    answ = upper(left(answ,1))
    pnum = C2D(answ)
    if pnum >= 65 & pnum <= 92 then
      answ = pnum - 64
  end
  lang = CheckAnswer(answ)
end

if lang = 0 | answ = 0 then EXIT

if prgrs then do
  Postmsg(10, 10, "Scion Translate (by Freddy Ariës)\Database: "||dbname||"\ \ ", PSCR)
  pgopen = 1
end

if lang = 15 | lang = 16 then do
  IF ~SHOW('L','locale.library') then do
    CALL ADDLIB('locale.library',0,-30)
  END;

  catalog = OpenCatalog("scion.catalog","english",0);
  d1 = ""
  dat_e1 = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
  do lcnt=1 to 12
    al = word(dat_e2, lcnt)
    a1 = GetCatalogStr(catalog, 175+lcnt, al);
    if upper(a1) ~= upper(al) then
      d1 = d1||a1||' '
  end
  a1 = GetCatalogStr(catalog, 189, "Abt")
  if upper(a1) ~= "ABT" then d1 = d1||a1||' '
  a2 = GetCatalogStr(catalog, 188, "About")
  if upper(a2) ~= "ABOUT" then do
    if length(a2) > 5 then
      d1 = d1||a1||' '
    else
      d1 = d1||a2||' '
  end

  a1 = GetCatalogStr(catalog, 191, "Bef")
  if upper(a1) ~= "BEF" then d1 = d1||a1||' '
  a2 = GetCatalogStr(catalog, 188, "Before")
  if upper(a2) ~= "Before" then do
    if length(a2) > 5 then
      d1 = d1||a1||' '
    else
      d1 = d1||a2||' '
  end

  a1 = GetCatalogStr(catalog, 193, "Aft")
  if upper(a1) ~= "AFT" then d1 = d1||a1||' '
  a2 = GetCatalogStr(catalog, 192, "After")
  if upper(a2) ~= "AFTER" then do
    if length(a2) > 5 then
      d1 = d1||a1
    else
      d1 = d1||a2
  end
end

select
  /* Make sure the string in datout is always <= the one in datin, or
   * the resulting string might not fit in the date field anymore.
   * Note: some 2-letter fields ('CA', 'VR', 'AV') can't follow this rule.
   */
  when lang = 1 then do
    datin = "MRT MAA MEI OKT CA CA. CIRCA VR VR. VOOR NA"
    datout= "Mar Mar May Oct Abt Abt About Bef Bef Bef Aft"
  end
  when lang = 2 then do
    datin = "MAR MAY ABT ABOUT BEF BEFORE AFT AFTER"
    datout= "Mrt Mei Ca Circa Vr Voor Na Na"
  end
  when lang = 3 then do
      datin = "MÄR Mär MRZ MAI OKT DEZ CA CA. UNGEFÄHR UNGEFäHR VOR NAC NACH"
      datout= "Mar Mar Mar May Oct Dec Abt Abt About About Bef Aft Aft"
  end
  when lang = 4 then do
    datin = "MAR MAY OCT DEC ABT ABOUT BEF BEFORE AFT AFTER"
    datout= "Mär Mai Okt Dez Ca Ca Vor Vor Nac Nach"
  end
  when lang = 5 then do
    datin = "FEV FéV FÉV AVR MAI UIN UIL OUT OÛT OûT DéC DÉC ENV ENVIRON AV AVANT APR APRES APRèS APRÈS"
    datout = "Feb Feb Feb Apr May Jun Jul Aug Aug Aug Dec Dec Abt About Bef Bef Aft After After After"
  end
  when lang = 6 then do
    datin = "FEB APR MAY JUN JUL AUG DEC ABT ABOUT BEF BEFORE AFT AFTER"
    datout= "Fév Avr Mai uin uil oût Déc Env Env Av Avant Apr Après"
  end
  when lang = 7 then do
    datin = "GEN MAG GIU LUG AGO SET OTT DIC INTORNO AL CA. PRIMA PRI DOPO DOP"
    datout = "Jan May Jun Jul Aug Sep Oct Dec About . Abt Bef Bef Aft Aft"
  end
  when lang = 8 then do
    datin = "JAN MAY JUN JUL AUG SEP OCT DEC ABOUT ABT BEFORE BEF AFTER AFT"
    datout= "Gen Mag Giu Lug Ago Set Ott Dic Ca. Ca. Prima Pri Dopo Dop"
  end
  when lang = 9 then do
    datin = "MAI OKT DES OMKRING CA. FøR FØR ETTER ETT"
    datout = "May Oct Dec About Abt Bef Bef After Aft"
  end
  when lang = 10 then do
    datin = "MAY OCT DEC ABOUT ABT BEFORE BEF AFTER AFT"
    datout= "Mai Okt Des Ca. Ca. Før Før Etter Ett"
  end
  when lang = 11 then do
    datin = "MAJ OKT UNGEFäR UNGEFÄR CA. FöRE FÖRE F. EFTER EFT"
    datout = "May Oct Dec About About Abt Bef Bef Bef After Aft"
  end
  when lang = 12 then do
    datin = "MAY OCT ABOUT ABT BEFORE BEF AFTER AFT"
    datout= "Maj Okt Ca. Ca. Före F. Efter Eft"
  end
  when lang = 13 then do
    datin = "TAM HEL MAA HUH TOU KES HEI ELO SYY LOK MAR JOU NOIN N. ENNEN ENN JäLKEEN JÄLKEEN JäL JÄL"
    datout = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec Abt Abt Bef Bef After After Aft Aft"
  end
  when lang = 14 then do
    datin = "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC ABOUT ABT BEFORE BEF AFTER AFT"
    datout= "Tam Hel Maa Huh Tou Kes Hei Elo Syy Lok Mar Jou Noin n. Ennen Enn Jäl Jäl"
  end
  when lang = 15 then do
   // datin = "TAM HEL MAA HUH TOU KES HEI ELO SYY LOK MAR JOU NOIN N. ENNEN ENN JäLKEEN JÄLKEEN JäL JÄL"

    datout = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec Abt Abt Bef Bef After After Aft Aft"
  end
  when lang = 16 then do
    datin = "JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC ABOUT ABT BEFORE BEF AFTER AFT"
   //  datout= "Tam Hel Maa Huh Tou Kes Hei Elo Syy Lok Mar Jou Noin n. Ennen Enn Jäl Jäl"
  end
  otherwise
    EndString("Invalid option: "lang)
end

if ~usereq then
  Tell("Parsing Personal Details...")
else if pgopen then
  Postmsg(,, "\\Processing person:\", PSCR)

GETTOTALIRN
TotalIRN = RESULT
do i = 1 to TotalIRN
  if pgopen then Postmsg(,,"\\\"||i||" (of "||TotalIRN||")", PSCR)
  EXISTPERSON i
  /* Skip deleted persons */
  if RESULT = 'YES' then
  do

    if progvers < 4 then do
      /* Since V4, sex is a toggle gadget, and conversion is unnecessary */
      GETSEX i
      sx = ConvertSex(RESULT)
      if sx ~= "" then PUTSEX i sx
    end

    GETBIRTHDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTBIRTHDATE i datestr
    GETBAPTISMDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTBAPTISMDATE i datestr
    GETDEATHDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTDEATHDATE i datestr
    GETBURIALDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTBURIALDATE i datestr
  end
end
if ~usereq then do
  Tell("Done ("||TotalIRN||" persons parsed).")

  /* Now the list of families... */
  Tell("Parsing Family Details...")
end
else if pgopen then
  Postmsg(,, "\\Processing family:\ ", PSCR)


GETTOTALFGRN
TotalFGRN = Result
do i = 1 to TotalFGRN
  if pgopen then Postmsg(,, "\\\"||i||" (of "||TotalFGRN||")", PSCR)
  EXISTFAMILY i
  /* Skip deleted families */
  if RESULT = 'YES' then do
    GETMARRYDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTMARRYDATE i datestr
    GETENGAGEDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTENGAGEDATE i datestr
    GETENDDATE i
    datestr = ParseDate(RESULT)
    if datestr ~= "" then PUTENDDATE i datestr
  end
end

if usereq then do
  rtezrequest('Scion Translation is ready.' || NL || 'Parsed '||,
    TotalIRN||' persons and '||TotalFGRN||' families.','_Ok','Translate Message:','rt_pubscrname = '||PSCR)
  if pgopen then Postmsg()
end
else
  EndString("Done ("||TotalFGRN||" families parsed)."||NL)

EXIT

CheckAnswer: PROCEDURE EXPOSE outp usereq pgopen scrdev pscr
parse arg str
if str < 0 | str > 16 then
  EndString("Invalid option: "||str||" -- program terminated.")
return str

ConvertSex: PROCEDURE EXPOSE lang
parse arg sxstr
if lang = '1' & sxstr = "V" then sxstr = "F"
else if lang = '2' & sxstr = "F" then sxstr = "V"
else if lang = '3' & sxstr = "W" then sxstr = "F"
else if lang = '4' & sxstr = "F" then sxstr = "W"
else if (lang = '9' | lang = '11') & sxstr = "K" then sxstr = "F"
else if (lang = '10' | lang = '12') & sxstr = "F" then sxstr = "K"
else if lang = '13' & sxstr = "N" then sxstr = "F"
else if lang = '14' & sxstr = "F" then sxstr = "N"
/* French and Italian: 'M' and 'F', same as in English */
else sxstr = ""
return sxstr

/* PARSEDATE SUBROUTINE */
/* For each word in the datestr string, see if it occurs in the datin
 * string. If it does, replace it with the equivalent in the datout string
 */
ParseDate: PROCEDURE EXPOSE datin datout
parse arg datestr
datestr = strip(datestr); /* remove leading blanks */
if datestr = "" then return datestr
rdate = translate(datestr,'  ','-/'); /* replace all '-' or '/' by ' ' */

datestr = upper(rdate)
 /* keep rdate in its original case, so we don't accidentally change
  * the case of any other words in the resulting
  */
cp = 1

/* check all words with the datin string */
do cnt = 1 to words(datestr)
  cw = word(datestr, cnt)
  num = find(datin, cw)
  if num > 0 then do
    rep = word(datout, num)
    if rep="." then rep=""
    rl = length(rep)
    cl = length(cw)
    cp = index(upper(rdate), cw, cp)
    rdate = delstr(rdate, cp, cl)
    rdate = insert(rep, rdate, cp-1)
  end
end
return rdate

Tell: PROCEDURE EXPOSE outp scrdev
parse arg str
if outp then
  writeln(scrdev, str)
return 0

TellNN: PROCEDURE EXPOSE outp scrdev
parse arg str
if outp then
  writech(scrdev, str)
return 0

EndString: PROCEDURE EXPOSE outp usereq pgopen scrdev pscr
parse arg str
/* If you turned off stdout, no error messages will be shown! */
if usereq then
  rtezrequest(str,'E_xit','Translate Message:','rt_pubscrname = '||PSCR)
else do
  Tell(str || '0A'x)
end
if pgopen then Postmsg()
if outp & ~usereq & (scrdev ~= stdout) then do
  Tell("Press <return> to exit.")
  readln(scrdev)
  close(scrdev)
end
EXIT